home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
qbbs
/
qktmbps.zip
/
QKTMBPS.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-08-16
|
7KB
|
277 lines
Program QkTmBPS;
Uses Dos, OpCRT, OpString, OpDate;
Type
CommandRec = record
Baud : string[4];
Day : string[4];
STime : Time;
ETime : Time;
end;
EventRec = record
Tag : string[15];
Commands : array[1..10] of CommandRec;
end;
var
EventOK : boolean;
x, y, TagNo : byte;
sTemp : string;
F : Text;
ThisBaud : string[4];
ThisDay : DayType;
ThisTime : Time;
ThisTag : string[15];
Tags : array[1..10] of EventRec;
TagFile : File of EventRec;
PrmInfo, EvtInfo : SearchRec;
procedure CheckCommandLine;
begin
if ParamCount <> 1 then
begin
writeln('Syntax: QkTmBPS Tag_Line');
Halt;
end;
ThisTag := StUpCase(ParamStr(1));
end;
procedure Initialize;
begin
EventOK := false;
ThisBaud := '';
ThisDay := DayOfWeek(Today);
ThisTime := CurrentTime;
for x := 1 to 10 do
begin
Tags[x].Tag := '';
for y := 1 to 10 do
begin
Tags[x].Commands[y].Baud := '';
Tags[x].Commands[y].Day := '';
Tags[x].Commands[y].STime := 0;
Tags[x].Commands[y].ETime := 0;
end;
end;
end;
procedure WritePrmFile;
var
Begun : boolean;
TagLine : byte;
sStart, sEnd : DateString;
begin
writeln;
writeln('Reading QkTmBPS.Evt -> Compiling QkTmBPS.Prm');
assign(F, 'QkTmBPS.Evt');
{$I-}
reset(F);
{$I+}
if IOResult <> 0 then
begin
writeln('Could NOT find QkTmBPS.Evt - Event Control File!');
Halt;
end;
assign(TagFile, 'QkTmBPS.Prm');
rewrite(TagFile);
TagNo := 1; TagLine := 0; Begun := false;
while (TagNo <= 10) AND NOT EOF(F) do
begin
readln(F, sTemp);
if (sTemp <> '') AND (sTemp[1] <> ';') then
begin
sTemp := StUpCase(sTemp);
if Begun then
begin
if sTemp <> 'END_DEF' then
begin
inc(TagLine);
if TagLine <= 10 then
begin
Tags[TagNo].Commands[TagLine].Baud := ExtractWord(1, sTemp, [' ']);
Tags[TagNo].Commands[TagLine].Day := ExtractWord(2, sTemp, [' ']);
sStart := ExtractWord(3, sTemp, [' ']);
sEnd := ExtractWord(4, sTemp, [' ']);
Tags[TagNo].Commands[TagLine].STime := TimeStringToTime('hh:mm', sStart);
Tags[TagNo].Commands[TagLine].ETime := TimeStringToTime('hh:mm', sEnd);
end;
end
else
begin
Begun := false;
TagLine := 0;
write(TagFile, Tags[TagNo]);
inc(TagNo);
end;
end
else
if sTemp = 'BEGIN_DEF' then
begin
Begun := true;
readln(F, sTemp);
sTemp := Trim(sTemp);
sTemp := StUpCase(sTemp);
Tags[TagNo].Tag := sTemp;
end;
end;
end;
SetFTime(TagFile, EvtInfo.Time);
close(F);
close(TagFile);
writeln('Done.');
end;
procedure CheckPrmFile;
begin
FindFirst('QkTmBPS.Evt', AnyFile, EvtInfo);
if DosError = 0 then
begin
FindFirst('QkTmBPS.Prm', AnyFile, PrmInfo);
if DosError <> 0 then WritePrmFile
else
if (PrmInfo.Time <> EvtInfo.Time) then WritePrmFile;
end
else
begin
writeln('Could NOT find QkTmBPS.Evt - Event Control File!');
Halt;
end;
end;
procedure ReadPrmFile;
begin
assign(TagFile, 'QkTmBPS.Prm');
{$I-}
reset(TagFile);
{$I+}
if IOResult <> 0 then
begin
writeln('Could NOT find QkTmBPS.Prm - Event Parameters File!');
Halt;
end;
TagNo := 0;
while (TagNo < 10) AND NOT EOF(TagFile) do
begin
inc(TagNo);
read(TagFile, Tags[TagNo]);
end;
close(TagFile);
end;
procedure ReadDorInfo;
begin
assign(F, 'DorInfo1.Def');
{$I-}
reset(F);
{$I+}
if IOResult <> 0 then
begin
writeln('Could NOT find DorInfo1.Def File!');
Halt;
end;
for x := 1 to 4 do ReadLn(F);
ReadLn(F, sTemp);
close(F);
ThisBaud := ExtractWord(1, sTemp, [' ']);
end;
function CheckTime(ThisTime, StarT, EndT : Time) : boolean;
begin
CheckTime := (ThisTime >= StarT) AND (ThisTime <= EndT);
end;
procedure ExitWithErrorLevel;
begin
for x := 1 to 10 do
begin
if ThisTag = Tags[x].Tag then
begin
for y := 1 to 10 do
begin
with Tags[x].Commands[y] do
begin
if Baud = ThisBaud then
begin
if Day = 'ALL' then
if CheckTime(ThisTime, STime, ETime) then Halt(0);
if Day = 'WK' then
case ThisDay of
Sunday, Monday, Tuesday,
Wednesday, Thursday, Friday :
if CheckTime(ThisTime, STime, ETime) then Halt(0);
end;
if Day = 'WKEND' then
case ThisDay of
Saturday, Sunday : if CheckTime(ThisTime, STime, ETime) then
Halt(0);
end;
if Day = 'MON' then
if (ThisDay = Monday) AND
CheckTime(ThisTime, STime, ETime) then Halt(0);
if Day = 'TUE' then
if (ThisDay = Tuesday) AND
CheckTime(ThisTime, STime, ETime) then Halt(0);
if Day = 'WED' then
if (ThisDay = Wednesday) AND
CheckTime(ThisTime, STime, ETime) then Halt(0);
if Day = 'THU' then
if (ThisDay = Thursday) AND
CheckTime(ThisTime, STime, ETime) then Halt(0);
if Day = 'FRI' then
if (ThisDay = Friday) AND
CheckTime(ThisTime, STime, ETime) then Halt(0);
if Day = 'SAT' then
if (ThisDay = Saturday) AND
CheckTime(ThisTime, STime, ETime) then Halt(0);
if Day = 'SUN' then
if (ThisDay = Sunday) AND
CheckTime(ThisTime, STime, ETime) then Halt(0);
end;
end;
end;
end;
end;
Halt(1);
end;
begin
CheckCommandLine;
Initialize;
CheckPrmFile;
ReadPrmFile;
ReadDorInfo;
ExitWithErrorLevel;
{$IFDEF DEBUG}
for x := 1 to 10 do
begin
ClrScr;
writeln('Tag # ',x,' Current Baud Rate: ', ThisBaud);
writeln('Tag Name: ', Tags[x].Tag);
writeln('Commands: ');
for y := 1 to 10 do
begin
write(Tags[x].Commands[y].Baud , ' ');
write(Tags[x].Commands[y].Day , ' ');
write(Tags[x].Commands[y].STime , ' ');
writeln(Tags[x].Commands[y].ETime, ' ');
end;
readln;
end;
{$ENDIF}
end.